home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / inc / set.inc < prev    next >
Text File  |  1998-09-21  |  14KB  |  455 lines
  1. {
  2.     $Id: set.inc,v 1.6 1998/07/30 12:16:29 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993,97 by Carl-Eric Codere,
  5.     member of the Free Pascal development team.
  6.  
  7.     See the file COPYING.FPC, included in this distribution,
  8.     for details about the copyright.
  9.  
  10.     This program is distributed in the hope that it will be useful,
  11.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  
  14.  **********************************************************************}
  15. {*************************************************************************}
  16. {  Converted by Carl Eric Codere                                          }
  17. {*************************************************************************}
  18. {  This inc. implements low-level set operations for the motorola         }
  19. {  68000 familiy of processors.                                           }
  20. {  Based on original code bt Florian Kl„mpfl  for the 80x86.              }
  21. {*************************************************************************}
  22.  
  23.  
  24.   { add the element b to the set pointed by p }
  25.   { On entry                                   }
  26.   {  a0    = pointer to set                    }
  27.   {  d0.b  = element to add to the set         }
  28.   { Registers destroyed: d0,a1,d6              }
  29.   procedure do_set;assembler;
  30.   asm
  31.     XDEF SET_SET_BYTE
  32.           move.l  d0,d6
  33.           { correct long position: }
  34.           {   -> (value div 32)*4 = longint }
  35.           {       (value shr 5)*shl 2       }
  36.           lsr.l  #5,d6
  37.           lsl.l  #2,d6
  38.           adda.l d6,a0       { correct offset from start address of set }
  39.  
  40.           move.l d0,d6       { bit is now in here                       }
  41.           andi.l #31,d0      { bit number is =  value mod 32            }
  42.  
  43.           { now bit set the value }
  44.           move.l  (a0),d0              { we must put bits into register }
  45.           bset.l  d6,d0                { otherwise btst will be a byte  }
  46.           { put result in carry flag } { operation.                     }
  47.           bne    @LDOSET1
  48.           andi.b #$fe,ccr              { clear carry flag }
  49.           bra    @LDOSET2
  50.        @LDOSET1:
  51.           ori.b  #$01,ccr              { set carry flag   }
  52.        @LDOSET2:
  53.           move.l  d0,(a0)              { restore the value at that location }
  54.                                        { of the set.                        }
  55.     end;
  56.  
  57.     { Finds an element in a set }
  58.     { a0   = address of set                                 }
  59.     { d0.b = value to compare with                          }
  60.     { CARRY SET IF FOUND ON EXIT                            }
  61.     { Registers destroyed: d0,a0,d6                         }
  62.   procedure do_in; assembler;
  63.   { Returns Carry set then = in set , otherwise carry is cleared }
  64.   {         (D0)                                                 }
  65.   asm
  66.        XDEF SET_IN_BYTE
  67.           move.l  d0,d6
  68.           { correct long position: }
  69.           {   -> (value div 32)*4 = longint }
  70.           {       (value shr 5)*shl 2       }
  71.           lsr.l  #5,d6
  72.           lsl.l  #2,d6
  73.           adda.l d6,a0       { correct offset from start address of set }
  74.  
  75.           move.l d0,d6       { bit is now in here                       }
  76.           andi.l #31,d0      { bit number is =  value mod 32            }
  77.  
  78.           move.l  (a0),d0              { we must put bits into register }
  79.           btst.l  d6,d0                { otherwise btst will be a byte  }
  80.           { put result in carry flag } { operation.                     }
  81.           bne    @LDOIN1
  82.           andi.b #$fe,ccr              { clear carry flag }
  83.           bra    @LDOIN2
  84.        @LDOIN1:
  85.           ori.b  #$01,ccr             { set carry flag   }
  86.        @LDOIN2:
  87.     end;
  88.  
  89.  
  90.  
  91.    { vereinigt set1 und set2 und speichert das Ergebnis in dest }
  92.  
  93.    procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
  94.    {  PSEUDO-CODE:
  95.        type
  96.          destination = array[1..8] of longint;
  97.         for i:=1 to 8 do
  98.            destination(dest^)[i] := destination(set1^)[i] OR destination(set2^)[i];
  99.     }
  100.     begin
  101.         asm
  102.            { saved used register }
  103.            move.l a2,-(sp)
  104.  
  105.            move.l 8(a6),a0
  106.            move.l 12(a6),a1
  107.            move.l 16(a6),a2
  108.  
  109.            move.l #32,d6
  110.  
  111.        @LMADDSETS1:
  112.  
  113.            move.b  (a0)+,d0
  114.            or.b    (a1)+,d0
  115.            move.b  d0,(a2)+
  116.            subq.b  #1,d6
  117.            bne     @LMADDSETS1
  118.            { restore register }
  119.            move.l  a2,(sp)+
  120.         end ['d0','d6','a0','a1'];
  121.      end;
  122.  
  123.    { computes the symetric diff from set1 to set2    }
  124.    { result in dest                                  }
  125.  
  126.    procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
  127.  
  128.      begin
  129.         asm
  130.            { saved used register }
  131.            move.l a2,-(sp)
  132.  
  133.            move.l 8(a6),a0
  134.            move.l 12(a6),a1
  135.            move.l 16(a6),a2
  136.  
  137.            move.l #32,d6
  138.  
  139.        @LMADDSETS1:
  140.  
  141.            move.b  (a0)+,d0
  142.            move.b  (a1)+,d1
  143.            eor.b   d1,d0
  144.            move.b  d0,(a2)+
  145.            subq.b  #1,d6
  146.            bne     @LMADDSETS1
  147.            { restore register }
  148.            move.l  a2,(sp)+
  149.         end;
  150.      end;
  151.  
  152.  
  153.   { bad implementation, but it's very seldom used }
  154.   procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
  155.  
  156.     begin
  157.        asm
  158.           move.b h,d0
  159.        @LSetRLoop:
  160.           cmp.b  l,d0
  161.           blt    @Lend
  162.           move.w d0,-(sp)
  163.           { adjust value to correct endian }
  164.           lsl.w  #8,d0
  165.           pea    p
  166.           jsr    SET_SET_BYTE
  167.           sub.b  #1,d0
  168.           bra    @LSetRLoop
  169.        @Lend:
  170.        end;
  171.     end;
  172.  
  173.  
  174.    { bildet den Durchschnitt von set1 und set2 }
  175.    { und speichert das Ergebnis in dest        }
  176.  
  177.    procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
  178.    {  type
  179.          larray = array[0..7] of longint;
  180.         for i:=0 to 7 do
  181.            larray(dest^)[i] := larray(set1^)[i] AND larray(set2^)[i];
  182.    }
  183.    begin
  184.         asm
  185.            { saved used register }
  186.            move.l a2,-(sp)
  187.            move.l 8(a6),a0
  188.            move.l 12(a6),a1
  189.            move.l 16(a6),a2
  190.  
  191.            move.l #32,d6
  192.  
  193.        @LMMULSETS1:
  194.  
  195.            move.b  (a0)+,d0
  196.            and.b   (a1)+,d0
  197.            move.b  d0,(a2)+
  198.            subq.b  #1,d6
  199.            bne     @LMMULSETS1
  200.            { restore register }
  201.            move.l  a2,(sp)+
  202.         end ['d0','d6','a0','a1'];
  203.      end;
  204.  
  205.  
  206.    { bildet die Differenz von set1 und set2 }
  207.    { und speichert das Ergebnis in dest     }
  208.  
  209.    procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
  210.    {  type
  211.          larray = array[0..7] of longint;
  212.      begin
  213.         for i:=0 to 7 do
  214.            larray(dest^)[i] := larray(set1^)[i] AND NOT (larray(set2^)[i]);
  215.      end;
  216.      }
  217.    begin
  218.         asm
  219.            { saved used register }
  220.            move.l a2,-(sp)
  221.            move.l 8(a6),a0
  222.            move.l 12(a6),a1
  223.            move.l 16(a6),a2
  224.  
  225.            move.l #32,d6
  226.  
  227.        @LSUBSETS1:
  228.            move.b  (a0)+,d0
  229.            move.b  (a1)+,d1
  230.            not.b   d1
  231.            and.b   d1,d0
  232.            move.b  d0,(a2)+
  233.            sub.b   #1,d6
  234.            bne     @LSUBSETS1
  235.            { restore register }
  236.            move.l  a2,(sp)+
  237.         end ['d0','d1','d6','a0','a1'];
  238.      end;
  239.  
  240.    { compare both sets }
  241.    { compares set1 and set2                             }
  242.    { zeroflag is set if they are equal                  }
  243.    { on entry :  a0 = pointer to first set              }
  244.    {          :  a1 = pointer to second set             }
  245.    procedure comp_sets; assembler;
  246.  
  247.         asm
  248.          XDEF SET_COMP_SETS
  249.            move.l #32,d6
  250.        @LMCOMPSETS1:
  251.            move.b (a0)+,d0
  252.            move.b (a1),d1
  253.            cmp.b  d1,d0
  254.            bne    @LMCOMPSETEND
  255.            adda.l #1,a1
  256.            sub.b  #1,d6
  257.            bne    @LMCOMPSETS1
  258.            { we are here only if the two sets are equal         }
  259.            { we have zero flag set, and that what is expected   }
  260.            cmp.b  d0,d0
  261.        @LMCOMPSETEND:
  262.      end;
  263.  
  264.   procedure do_set(p : pointer;b : word);[pub